perm filename MUSIC5[2,LCS] blob
sn#107298 filedate 1975-04-04 generic text, type T, neo UTF8
CPASS1 PASS 1 MAIN PROGRAM
CPASS1 *** MUSIC V *** THIS VERSION RUNS ON THE PDP10, JULY 14,1971
COMMON P(100),IP(10),D(2000),IPDP
DATA IPDP/0/
C***** PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE.
99 FORMAT(' TYPE FILE NAME'/)
999 FORMAT(A5)
TYPE 99
ACCEPT 999,FLNM
CALL IFILE(1,FLNM)
C***** ABOVE 5 LINES FOR PDP10 **********
C INITIALIZATION
C NOMINAL SAMPLING RATE.
D(4)=10000.0
C ERROR FLAG
IP(2)=0
P(2)=0.0
CC NWRITE = 2
NWRITE=20
C**** PDP DSK0=DEVICE 20 *******
CC REWIND NWRITE
CC CALL READ0
CALL READ1
C*********** PDP *************
C MAIN LOOP
100 CALLREAD1
I1=P(1)
IF (I1.GE.1.AND.I1.LE.12) GO TO 103
IP(2)=1
CC WRITE (6,200)
PRINT 200
C******** PDP *******
200 FORMAT (' NON-EXISTENT OPCODE ON DATA STATEMENT')
GO TO 100
103 GO TO (1,1,1,1,5,6,7,1,9,1,1,12),I1
1 CALL WRITE1 (NWRITE)
GO TO 100
5 PRINT 110
CC 5 WRITE (6,110)
C******** PDP *******
110 FORMAT (' END OF SECTION IN PASS 1')
GO TO 1
6 CALL WRITE1 (NWRITE)
CC WRITE (6,111)
PRINT 111
C******** PDP *******
111 FORMAT (' END OF PASS I')
IF(IP(2).EQ.1) CALL HARVEY
CALL EXIT
C SET VARIABLES IN PASS 1
7 I2=P(3)
I3=I2+IP(1)-4
DO 104I4=I2,I3
104 D(I4)=P(I4-I2+4)
GO TO 100
9 I6=P(3)
IF (I6.GE.1.AND.I6.LE.5) GO TO 107
IP(2)=1
CC WRITE (6,201)
PRINT 201
C******** PDP *******
201 FORMAT (' NON-EXISTENT PLF SUBROUTINE CALLED')
GO TO 100
12 CALL WRITE1 (NWRITE)
GO TO 7
107 GO TO (21,22,23,24,25),I6
21 CALLPLF1
GO TO 100
22 CALLPLF2
GO TO 100
23 CALLPLF3
GO TO 100
24 CALLPLF4
GO TO 100
25 CALLPLF5
GO TO 100
END
CWRIT1 PASS 1 DATA-WRITING ROUTINE
C *** MUSIC V ***
SUBROUTINEWRITE1(N)
COMMON P(100),IP(10)
K=IP(1)
WRITE(N )K,(P(J),J=1,K)
RETURN
END
SUBROUTINE PLF
COMMON P(100),IP(10),D(2000)
CC ENTRY PLF1
CC ENTRY PLF2
CC ENTRY PLF3
CC ENTRY PLF4
CC ENTRY PLF5
END
CERRO1 GENERAL ERROR ROUTINE
C *** MUSIC V ***
SUBROUTINEERROR(I)
PRINT100,I
100 FORMAT(13HERROR OF TYPEI5)
RETURN
END
SUBROUTINE HARVEY
CC WRITE (6,1)
PRINT 1
C******** PDP *******
1 FORMAT (' WHERE IS HARVEY')
CALL EXIT
END
SUBROUTINEMOVR(IBCD,LA,LB)
DIMENSION IBCD(300)
DO 1 J=LA,LB
CC 1 IBCD(J)=15-(-IBCD(J))/16777216
C******* PDP *******
1 IBCD(J)=IBCD(J)/536870912-48
2 DUMMY=0
C TO SET BREAKPOINT.
RETURN
END
CREAD1 INTERPRETATIVE READING ROUTINE
C****MUSIC V****
SUBROUTINEREAD1
COMMON P(100),IP(10),D(2000),IPDP
C***** PDP ***** IPDP WAS ADDED TO COMMON LIST IN PLACE OF ENTRY FEATURE.
DIMENSION CARD(129),ICAR(128),IBCD(300),LOP(3,30)
DIMENSIONBCD(300)
DIMENSIONIBC(12),IVT(4)
EQUIVALENCE(CARD,ICAR)
EQUIVALENCE(BCD,IBCD)
DATANOPS,NBC,NC/26,3,72/
DATA IDEC,ISTAR/'.','*'/
CCC DATA IBC(1),IBC(2),IBC(3),IBC(4)/'=',' ',',','-'/
DATA IBC(1),IBC(2),IBC(3),IBC(4)/';',' ',',','-'/
C********* NO!!!!! THE CHARACTER = HAS BEEN SUBSTITUTED FOR
C THE SEMICOLON AS THE END OF STATEMENT DELIMITER
DATA IVT/'P','F','B','V'/
DATA LOP/'N','O','T','I','N','S','G','E','N','S','V','3',
1 'S','E','C','T','E','R','S','V','1','S','V','2','P','L','F',
2 'P','L','S','S','I','3','S','I','A','C','O','M','E','N','D',
3 'O','U','T','O','S','C','A','D','2','R','A','N','E','N','V',
4 'S','T','R','A','D','3','A','D','4','M','L','T','F','L','T',
5 'R','A','H','S','E','T',0,0,0,0,0,0,0,0,0,0,0,0/
C******* LAST 12 LOCATIONS NOT YET USED. **** PDP *******
EQUIVALENCE (JSEMI,IBC(1)),(JBLANK,IBC(2))
C TO SCAN INPUT DATA TO #, ORGANIZE FIELDS AND PRINT
IF(IPDP.EQ.0)GO TO 99
C********** PDP **************
IF(END+SNA8-1.)10,10,90
10 IBK=2
END=0.
ERR=0.
NUMU=0
ISEMI=1
L=3
J=0
11 I=I+1
IF(I.GT.NC)GO TO 15
IF(J.EQ.299)GO TO 21
DO 13N=1,NBC
IF(ICAR(I)-IBC(N))13,12,13
12 GO TO (20,16,18),N
C ; BLA ,
13 CONTINUE
J=J+1
IBCD(J)=ICAR(I)
IBK=1
GO TO 11
14 IBK=N
GO TO 11
CC 15 READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC)
C******** PDP ********
15 READ (1,1,ERR=95,END=95) I, (CARD(I),I=1,NC)
C***** PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS!
1 FORMAT(I,128A1)
CC 1 FORMAT(128A1)
PRINT 2,(CARD(I),I=1,NC)
2 FORMAT(1H 128A1)
I=0
GO TO 11
16 GO TO (17,11,11),IBK
17 IBK=N
J=J+1
IBCD(J)=JBLANK
GO TO (11,21),ISEMI
18 GO TO (17,14,19),IBK
19 J=J+1
IBCD(J)=0
GO TO 17
20 ISEMI=2
GO TO (17,21,19),IBK
21 J=J+1
IBCD(J)=JSEMI
C TO SCAN FOR OP CODE
DO 24N=1,NOPS
M=N
DO 23K=1,3
IF (IBCD(K)-LOP(K,N)) 24,23,24
23 CONTINUE
GO TO 26
24 CONTINUE
GO TO 40
26 NP=1
27 L=L+1
IF(IBCD(L)-JBLANK)27,29,27
29 GO TO (100,200,300,400,500,600,700,800,900,1000,1100,1200,1300,
1217,201,202,203,204,205,206,207,208,209,210,211,212),M
C OP CODE 1 TO PLAY NOTE
100 P(1)=1.
GO TO 30
C OP CODE 2 TO DEFINE INSTRUMENT
200 P(1)=2.
IDEF=1
N1=1
GO TO 70
2000 P(2)=XN
N1=2
GO TO 70
2001 P(3)=XN
IP(1)=3
GO TO 50
C OUT BOX
201 P(3)=101.
NPW=2
IF(STER)220,220,2011
2011 SNA8=1.
STER=0.
GO TO 220
C OSCILLATOR
202 P(3)=102.
NPW=5
GO TO 220
C ADD 2
203 P(3)=103.
NPW=3
GO TO 220
C RANDOM AND INTERPOLATE
204 P(3)=104.
NPW=6
GO TO 220
C LINEAR ENVELOPE GENERATOR
205 P(3)=105.
NPW=7
GO TO 220
C STEREO OUT BOX
206 P(3)=106.
NPW=3
IF(STER)220,2061,220
2061 SNA8=1.
STER=1.
GO TO 220
C THREE INPUT ADDER
207 P(3)=107.
NPW=4
GO TO 220
C FOUR INPUT ADDER
208 P(3)=108.
NPW=5
GO TO 220
C MULTIPLIER
209 P(3)=109.
NPW=3
GO TO 220
C FILTER
210 P(3)=112.
NPW=4
GO TO 220
C RANDOM AND HOLD
211 P(3)=111.
NPW=5
GO TO 220
C SET NEW FUNCTION
212 P(3)=110.
NPW=1
GO TO 220
C END OF INSTRUMENT
217 IP(1)=2
IDEF=0
END=1.
GO TO 50
C UNNAMED UNIT - NUMERICAL NAME ASSUMED
218 N1=8
NUMU=1
L=0
GO TO 70
219 M=XN+14.
IF(XN.LT.11.)GO TO 29
P(3)=XN
C TO INTERPRET VARS IN UNIT DEFS
220 NP=3
221 IF(IBCD(L+1)-JSEMI)222,240,222
222 NP=NP+1
L=L+1
DO 223N=1,4
IF(IBCD(L)-IVT(N))223,225,223
223 CONTINUE
224 L=L+1
IF(IBCD(L).EQ.JBLANK)GO TO 46
GO TO 224
225 GO TO (231,232,233,234),N
C P TYPE
231 N1=3
GO TO 70
2311 P(NP)=XN
GO TO 221
C F TYPE
232 N1=4
GO TO 70
2321 P(NP)=-(XN+100.)
GO TO 221
C B TYPE
233 N1=5
GO TO 70
2331 P(NP)=-XN
GO TO 221
C V TYPE
234 N1=6
GO TO 70
2341 P(NP)=XN+100.
GO TO 221
240 IF(NUMU.EQ.1)GO TO 242
241 IF(NPW+3-NP)42,242,42
242 IP(1)=NP
GO TO 50
C OP CODE 3 - TO GENERATE FUNCTION
300 P(1)=3.
GO TO 30
C OP CODE 4 - TO SET PARAM 3RD PASS
400 P(1)=4.
GO TO 30
C OP CODE 5 TO END SEC
500 P(1)=5.
GO TO 30
C OP CODE 6 TO TERMINATE PIECE
600 P(1)=6.
GO TO 30
C OP CODE 7 TO SET PARAM 1ST PASS
700 P(1)=7.
GO TO 30
C OP CODE 8 TO SET PARAM 2ND PASS
800 P(1)=8.
GO TO 30
C OP CODE 9 TO EXECUTE SUB 1ST PASS
900 P(1)=9.
GO TO 30
C OP CODE 10 TO EXECUTE SUB 2ND PASS
1000 P(1)=10.
GO TO 30
C OP CODE 11 TO SET INTEGER 3RD PASS
1100 P(1)=11.
GO TO 30
C OP CODE 12 TO SET INTEGER ALL PASSES
1200 P(1)=12.
GO TO 30
C OP CODE 13 FOR COMMENTS
1300 IF(IBCD(L)-JSEMI)1301,10,1301
1301 L=L+1
GO TO 1300
C TO STORE PFIELDS
30 IF(IDEF)32,32,43
32 IF(IBCD(L+1)-JSEMI)33,34,33
33 NP=NP+1
N1=7
GO TO 70
331 P(NP)=XN
GO TO 32
34 IP(1)=NP
IF(NP-1)47,47,50
C ERRORS
40 IF(IDEF)41,41,218
41 L=L+1
IF(IBCD(L).NE.JSEMI)GO TO 41
PRINT 3
3 FORMAT(26H OP CODE NOT UNDERSTOOD)
GO TO 49
42 PRINT 4
4 FORMAT(44H UNIT CONTAINS WRONG NUMBER OF PARAMETERS)
GO TO 49
43 PRINT 5
5 FORMAT(36H INSTRUMENT DEFINITION INCOMPLETE)
ERR=1.
IDEF=0
GO TO 32
44 PRINT 6
6 FORMAT(25H ERROR IN NUMERIC DATA)
ERR=1.
IF(NUMU.EQ.1)GO TO 45
GO TO 30
45 PRINT 7
7 FORMAT(46H+ FOR UNIT DESIGNATION)
P(3)=0.
GO TO 220
46 PRINT 8
8 FORMAT(40H IMPROPER VARIABLE IN UNIT DEFINITION)
ERR=1.
GO TO 221
47 PRINT 9
9 FORMAT(24H STATEMENT INCOMPLETE)
49 IP(2)=1
GO TO 10
50 IF(ERR.EQ.1.)GO TO 49
RETURN
C CONVERSION OF NUMERIC FIELD TO FLOATING POINT
70 SGN=1.
IF(IBCD(L+1).NE.IBC(4))GO TO 79
SGN=-1.
L=L+1
79 L1=L+1
LD=L1
XN=0.
71 L=L+1
C *** I DON'T UNDERSTAND THIS PART OF THE SCANNER!
CC IF(IBCD(L).EQ.JBLANK)GO TO 77
IF(IBCD(L)-JBLANK)72,77,72
C THIS LOOKS FOR #S, LETTERS, BLANKS, DECI.PTS, & *S. OTHERWISE=ERROR!?
C******** PDP ********
72 IF(IBCD(L).LT.10)GO TO 71
IF(IBCD(L)-IDEC)74,71,74
74 IF(IBCD(L)-ISTAR)76,71,76
76 GO TO 71
C ERROR CHECK IS REMOVED!
CC**NEXT 2 LINES BY-PASSED*** 76 L=L+1
IF(IBCD(L).EQ.JBLANK)GO TO 44
GO TO 76
77 IF(IBCD(L1)-ISTAR)80,78,80
78 XN=P(NP)
GO TO 89
80 DO 81LL=L1,L
LD=LL
IF(IBCD(LL)-IDEC)81,82,81
81 CONTINUE
82 IEX=0
LA=L1
LB=LD-1
IF(LD-L1)86,86,83
83 IEX=LD-LA
84 CALL MOVR (IBCD,LA,LB)
DO 85 LL=LA,LB
IEX=IEX-1
XI=IBCD(LL)
85 XN=XN+XI*10.**IEX
86 IF(L-LB-2)88,88,87
87 LA=LD+1
LB=L-1
GO TO 84
88 XN=XN*SGN
89 GO TO (2000,2001,2311,2321,2331,2341,331,219),N1
C TO WRITE SIA 8 FOR MONO STEREO CONTROL
90 P(1)=12.
P(3)=8.
P(4)=STER
IP(1)=4
END=0.
SNA8=0.
GO TO 50
C FOR PREMATURE END OF FILE ON INPUT
95 NP=2
IP(2)=1
L=0
IBCD(1)=JSEMI
GO TO 600
C TO INITIALIZE
CC ENTRYREAD0
CC READ (5,1,ERR=95,END=95) (CARD(I),I=1,NC)
C******** PDP ********
99 READ (1,1,ERR=95,END=95) I,(CARD(I),I=1,NC)
C***** PDP ***** FIRST 'I' IS FOR PDP LINE NUMBERS!
CC WRITE (6,2) (CARD(I),I=1,NC)
PRINT 2,(CARD(I),I=1,NC)
C******** PDP *******
IPDP=1
I=0
IDEF=0
IBK=2
STER=0.
END=0.
SNA8=0.
RETURN
END
CPASS2 PASS 2 MAIN PROGRAM
C *** MUSIC V ***
DIMENSIONG(1000),I(1000),T(1000),D(10000),P(100),IP(10)
COMMONIP,P,G,I,T,D,IXJQ,TLAST,BLAST
C INIALIZING PROGRAM
C NOMINAL SAMPLING RATE, NOTE PARAMETER LENGTH, NUMBER OF CARDS
C NO OF OP CODES, PASS II REPORT PRINT PARAMETER
G(1)=0.
G(2)=0.
G(4)=10000.0
NPAR=10000
NCAR=1000
NOPC=12
IXJQ=0
IEND=0
CC***** NREAD=2
CC***** NWRITE=3
NREAD=20
NWRITE=21
REWIND NREAD
REWIND NWRITE
C INIALIZE SECTION
150 ID=1
IN=1
TLAST=0.
BLAST=0.
C READ SECTION OF DATA
106 CALL READ2(NREAD)
I1=IP(1)
D(ID)=I1
I(IN)=ID
T(IN)=P(2)
DO 100I2=1,I1
I3=ID+I2
100 D(I3)=P(I2)
ID=ID+I1+1
IF(ID-NPAR)102,102,101
101 CALLERROR(20)
STOP
102 IN=IN+1
IF(IN-NCAR)103,103,101
103 IF(P(1)-5.0)104,110,104
104 IF(P(1)-6.0)106,105,106
105 IEND=1
GO TO 110
C SORT SECTION
C**** NOT USED ****** 110 CALLSORTFL
110 IN=IN-1
CALLSORT(T(1),T(2),IN,I)
C EXECUTE OP CODES M SECTION
120 DO 1I4=1,IN
I5=I(I4)
I6=D(I5+1)
IF(I6)121,121,122
121 CALLERROR(21)
GO TO 1
122 IF(I6-NOPC)123,123,121
123 GO TO (2,2,2,2,2,2,7,8,7,10,2,8),I6
7 CALLERROR(22)
GO TO 1
8 I7=D(I5)
I8=I5+4
I9=I5+I7
I10=IFIX(D(I5+3))-I8
DO 124I11=I8,I9
I12=I10+I11
124 G(I12)=D(I11)
IF(I6-12)1,2,1
10 I13=D(I5+3)
IP(2)=I5
IF(I13)125,125,126
125 CALLERROR(23)
GO TO 1
126 IF(I13-5)127,127,125
127 GO TO (21,22,23,24,25),I13
21 CALLPLS1
GO TO 1
22 CALLPLS2
GO TO 1
23 CALLPLS3
GO TO 1
24 CALLPLS4
GO TO 1
25 CALLPLS5
GO TO 1
C WRITE OUT SECTION
2 IP(1)=D(I5)
I18=IP(1)
DO 133I19=1,I18
I20=I19+I5
133 P(I19)=D(I20)
CALL WRITE2 (NWRITE)
1 CONTINUE
C END SECTION OR PASS
140 IF(IEND)141,141,143
141 PRINT142
142 FORMAT (' END OF SECTION PASS II')
GO TO 150
143 PRINT144
144 FORMAT (' END OF PASS II')
STOP
END
CREAD2 PASS 2 DATA INPUT ROUTINE
C *** MUSIC V ***
SUBROUTINEREAD2(N)
DIMENSIONIP(10),P(100)
COMMONIP,P
READ(N)K,(P(J),J=1,K)
IP(1)=K
RETURN
END
CSORT SORTING PROGRAM
C *** MUSIC V ***
SUBROUTINE SORT(A,B,N,L)
DIMENSION A(N),L(N)
C
C SORT SORTS THE A ARRAY INTO ASCENDING NUMERICAL ORDER, PERFORMING
C THE SAME OPERATIONS ON ARRAY L AS ON A
C
N1=N-1
DO 10 I=1,N1
IN=I+1
DO 20 J=IN,N
IF(A(I).LE.A(J))GO TO 20
T=A(I)
A(I)=A(J)
A(J)=T
NT=L(I)
L(I)=L(J)
L(J)=NT
20 CONTINUE
10 CONTINUE
RETURN
CC******* ENTRY SORTFL
CC******* RETURN
END
CWRIT2 DATA OUTPUTING ROUTINE FOR PASS 2
C *** MUSIC V ***
SUBROUTINE WRITE2(N)
COMMON IP(10),P(100),G(1000),I(1000),T(1000),D(10000),IXJQ,TLAST,B
1LAST
IF(G(2).EQ.0.)GO TO 150
X=P(2)
Y=P(4)
ILOC=G(2)
IF(P(1).NE.1.)GO TO 50
P(4)=P(4)*60./CON(G,ILOC,P(2))
50 P(2)=TLAST+(P(2)-BLAST)*60./CON(G,ILOC,P(2))
TLAST=P(2)
BLAST=X
150 CALL CONVT
K=IP(1)
WRITE(N)K,(P(J),J=1,K)
C *** PASS II REPORT IS OPTIONAL ***
IF(G(1).NE.0.)RETURN
IF(IXJQ.EQ.0)PRINT100
IXJQ=10
100 FORMAT(15H1PASS II REPORT/11H0(WORD CNT))
PRINT101,K,(P(J),J=1,K)
IF(G(2).NE.0.)PRINT102,X,Y
101 FORMAT(I8,10(F9.3))
102 FORMAT(1H+,110X,2HB=,F7.4,2HD=,F7.4)
RETURN
END
CCON2 PASS 2 FUNCTION INTERPOLATER
C *** MUSIC V ***
FUNCTION CON(G,I,T)
DIMENSION G(I)
DO 10 J=I,1000,2
IF (G(J)-T) 10,20,30
30 CON = G(J-1)+((T-G(J-2))/(G(J)-G(J-2)))*(G(J+1)-G(J-1))
RETURN
10 CONTINUE
20 CON = G(J+1)
RETURN
END
C CONVT FOR UNIT GENERATORS CHECK
C
C DUMMY NO OPERATION ACTUALLY PERFORMED
C****** WHEN DUMMY IS REMOVED ANOTHER CONVT MUST!!!! BE LOADED!!!*****
C*** SUBROUTINE CONVT
C*** COMMON IP(10),P(100),G(1000)
C*** RETURN
C*** END
CERRO1 GENERAL ERROR ROUTINE
C *** MUSIC V ***
SUBROUTINEERROR(I)
PRINT100,I
100 FORMAT (' ERROR OF TYPE',I5)
RETURN
END
CC***** SUBROUTINE PLS
CC***** ENTRY PLS1
CC***** ENTRY PLS2
CC***** ENTRY PLS3
CC***** ENTRY PLS4
CC***** ENTRY PLS5
CC***** END
SUBROUTINE PLS1
RETURN
END
SUBROUTINE PLS2
RETURN
END
SUBROUTINE PLS3
RETURN
END
SUBROUTINE PLS4
RETURN
END
SUBROUTINE PLS5
RETURN
END
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
C DATA SPECIFICATION
INTEGER PEAK
DIMENSION T(50),TI(50),ITI(50)
COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR
CC******* DATA IIIRD/Z5EECE66D/
DATA IIIRD/976545367/
C SET I ARRAY =0 (7/10/69)
DATA I/15000*0/
C**************
C INIALIZATION OF PIECE
C ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
I(7)=IIIRD
IP9=IP(9)
PEAK=0
NRSOR=0
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
REWIND NREAD
REWIND NWRITE
TYPE 10001
ACCEPT 10002,FLNM,IDSK
C TYPE 'PASS2' OR FILENAME + ANY POS.NUMB. TO WRITE SMPLS ON DSK.
IF(FLNM.EQ.' '.OR.FLNM.EQ.'PASS2')FLNM='FOR21'
CALL IFILE(21,FLNM)
IF(IDSK.LE.0)GO TO 10003
J='MUSAA'
CALL PUTFILE(J)
C IF IDSKā„1, SAMPLES WILL BE WRITTEN ON DSK (MUSAA.DMD)
IDSK=0
GO TO 10002
10003 IDSK=-1
10001 FORMAT(' TYPE FILE NAME'/)
10002 FORMAT(A5,I)
C**** ABOVE FOR PDP IO ********
SCLFT=IP(12)
I(2)=IP(4)
MS1=IP(7)
MS3=MS1+(IP(8)*IP(9))-1
MS2=IP(8)
I(4)=IP(3)
MOUT=IP(10)
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220N1=MS1,MS3,MS2
220 I(N1)=-1
DO 221N1=1,IP9
221 TI(N1)=1000000.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALLERROR(1)
GO TO 204
202 IF(IP(1)-IOP)201,203,203
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
GO TO 204
3 IGEN=P(3)
GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 CALLGEN2
GO TO 204
283 CALLGEN3
GO TO 204
284 CALLGEN4
GO TO 204
285 CALLGEN5
GO TO 204
4 IVAR=P(3)
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)*SCLFT
GO TO 204
6 CALL FROUT3(IDSK)
STOP
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
IF(I(N1)+1)230,231,230
230 CONTINUE
CALLERROR(2)
GO TO 204
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+IP(8)-1
DO 232N1=M1,M2
M5=N1-M1+1
232 I(N1)=P(M5)*SCLFT
I(M1 )=P(3)
DO 233N1=M3,M4
233 I(N1)=0
DO 235N1=1,IP9
IF(TI(N1)-1000000.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALLERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I(2)
M2=IP(5)+IFIX(P(3))
I(M2)=M1
218 CALL DATA (NREAD)
IF(I(1)-2)210,210,211
210 I(M1)=0
I(2)=M1+1
GO TO 204
211 I(M1)=P(3)
M3=I(1)
I(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 I(M1)=-IP(2)+(M5+101)*IP(6)
GO TO 216
301 I(M1)=-IP(13)+(M5+1)*IP(14)
GO TO 216
213 IF(M5- 100 )214,214,215
214 I(M1)=M5
GO TO 216
215 I(M1)=M5+262144
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T(2)=P(2)
250 TMIN=1000000.
IREST=1
DO 241N1=1,IP9
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(1000000.-TMIN)251,251,243
243 IF(TMIN-T(2))245,245,246
245 T(3)=TMIN
GO TO 260
246 T(3)=T(2)
GO TO 260
247 IF(T(1)-T(2))249,200,200
249 TI(MNOTE)=1000000.
M2=ITI(MNOTE)
I(M2)=-1
GO TO 250
C SETUP REST
251 T(3)=T(2)
IREST=2
GO TO 260
C PLAY
260 ISAM=(T(3)-T(1))*FLOAT(I(4))+.5
T(1)=T(3)
IF(ISAM)247,247,266
266 IF(ISAM-IP(14))262,262,263
262 I(5)=ISAM
ISAM=0
GO TO 264
263 I(5)=IP(14)
ISAM=ISAM-IP(14)
264 IF(I(8))290,290,291
290 M3=MOUT+I(5)-1
MSAMP=I(5)
GO TO 292
291 M3=MOUT+(2*I(5))-1
MSAMP=2*I(5)
292 DO 267N1=MOUT,M3
267 I(N1)=0
GO TO (268,265),IREST
268 DO 270NS1=MS1,MS3,MS2
IF(I(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=IP(5)+I(NS1)
IGEN=I(IGEN)
272 I(6)=IGEN
CC***** IF(I(IGEN)-101)293,294,294
CC***** 293 CALLSAMGEN(I)
C**** ABOVE FOR MACHINE LANG. UNIT GENERATORS *******
CC***** GO TO 295
294 CALLFORSAM
295 IGEN=I(IGEN+1)
IF(I(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END
CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C *** MUSIC V ***
SUBROUTINEFORSAM
DIMENSION I(15000),P(100),IP(20),L(8),M(8)
COMMONI,P/PARM/IP
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8)),(RN1,IRN1),(RN3,IRN3),(RN,I
3RN)
CC***** DATA IMULT/Z5EECE66D/
DATA IIIRD/976545367/
SFI=1./FLOAT(IP(12))
SFF=1./FLOAT(IP(15))
SFID=FLOAT(IP(12))
SFXX=FLOAT(IP(12))/FLOAT(IP(15))
XNFUN=IP(6)-1
C COMMON INITIALIZATION OF GENERATORS
N1=I(6)+2
N2=I(N1-1)-1
DO 204J1=N1,N2
J2=J1-N1+1
IF(I(J1))200,201,201
200 L(J2)=-I(J1)
M(J2)=1
GO TO 204
201 M(J2)=0
IF(I(J1)-262144)202,202,203
C***** WHAT DOES THE BIG NUMBER DO?????
202 L(J2)=I(J1)+I(3)-1
GO TO 204
203 L(J2)=I(J1)-262144
204 CONTINUE
NSAM=I(5)
N3=I(N1-2)
NGEN= N3 -100
GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
112 RETURN
C UNIT GENERATORS
C OUTPUT BOX
101 IF(M1)260,260,261
260 IN1=I(L1)
261 CONTINUE
DO 270J3=1,NSAM
IF(M1)265,265,264
264 J4=L1+J3-1
IN1=I(J4)
265 J5=L2+J3-1
I(J5)=IN1+I(J5)
270 CONTINUE
RETURN
C OSCILLATOR
102 SUM=FLOAT(I(L5))*SFI
IF(M1)280,280,281
280 AMP=FLOAT(I(L1))*SFI
281 IF(M2)282,282,283
282 FREQ=FLOAT(I(L2))*SFI
283 CONTINUE
DO 293J3=1,NSAM
J4=INT(SUM)+L4
F=FLOAT(I(J4))
IF(M2)285,285,286
285 SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3-1
SUM=SUM+FLOAT(I(J4))*SFI
CC 290 IF(SUM-XNFUN)288,287,287
290 IF(SUM.GE.XNFUN)GO TO 287
CC 287 SUM=SUM-XNFUN
IF(SUM.LT.0.0)GO TO 289
288 J5=L3+J3-1
IF(M1)291,291,292
291 I(J5)=IFIX(AMP*F*SFXX)
GO TO 293
C**********
287 SUM=SUM-XNFUN
GO TO 288
289 SUM=SUM+XNFUN
GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
292 J6=L1+J3-1
I(J5)=IFIX(FLOAT(I(J6))*F*SFF)
293 CONTINUE
I(L5)=IFIX(SUM*SFID)
RETURN
C ADD TWO BOX
103 IF(M1)250,250,251
250 IN1=I(L1)
251 IF(M2)252,252,253
252 IN2=I(L2)
253 DO 258J3=1,NSAM
IF(M1)255,255,254
254 J4=L1+J3-1
IN1=I(J4)
255 IF(M2) 257,257,256
256 J5=L2+J3-1
IN2=I(J5)
257 J6=L3+J3-1
I(J6)=IN1+IN2
258 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR
104 SUM=FLOAT(I(L4))*SFI
IF(M1)310,310,311
310 XIN1=FLOAT(I(L1))*SFI
311 IF(M2)312,312,313
312 XIN2=FLOAT(I(L2))*SFI
313 IRN1=I(L5)
IRN3=I(L6)
DO 340J3=1,NSAM
IF(M1)316,316,315
315 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
316 IF(M2)318,318,317
317 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
318 IF(SUM-XNFUN)320,319,319
319 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN4=(2.*FLOAT(I(7))*SFF-1.)
RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 J7=L3+J3-1
I(J7)=XIN1*(RN1+(RN2*SUM)/XNFUN)*SFID
SUM=SUM+XIN2
340 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN1
I(L6)=IRN3
RETURN
C ENVELOPE GENERATOR
105 SUM=FLOAT(I(L7))*SFI
IF(M1)380,380,381
380 XIN1=FLOAT(I(L1))*SFI
381 IF(M4)382,382,383
382 XIN4=FLOAT(I(L4))*SFI
383 IF(M5)384,384,385
384 XIN5=FLOAT(I(L5))*SFI
385 IF(M6)386,386,387
386 XIN6=FLOAT(I(L6))*SFI
387 X1=XNFUN/4.
X2=2.*X1
X3=3.*X1
DO 403 J3=1,NSAM
J4=INT(SUM)+L2
F=FLOAT(I(J4))
IF(M1)405,405,404
404 J8=L1+J3-1
XIN1=FLOAT(I(J8))*SFI
405 IF(SUM-XNFUN)389,388,388
388 SUM=SUM-XNFUN
389 IF(SUM-X1)390,390,393
390 IF(M4)392,392,391
391 J4=L4+J3-1
XIN4=FLOAT(I(J4))*SFI
392 SUM=SUM+XIN4
GO TO 402
393 IF(SUM-X2)394,394,397
394 IF(M5)396,396,395
395 J5=L5+J3-1
XIN5=FLOAT(I(J5))*SFI
396 SUM=SUM+XIN5
GO TO 402
397 IF(M6)400,400,399
399 J6=L6+J3-1
XIN6=FLOAT(I(J6))*SFI
400 SUM=SUM+XIN6
402 J7=L3+J3-1
I(J7)=IFIX(XIN1*F*SFXX)
403 CONTINUE
I(L7)=IFIX(SUM*SFID)
RETURN
C STEREO OUTPUT BOX
106 IF(M1)500,500,501
500 IN1=I(L1)
501 IF(M2)502,502,503
502 IN2=I(L2)
503 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 510J3=1,NSSAM,2
IF(M1)505,505,504
CC*** 504 J4=L1+J3-1
504 J4=L1+ICT
IN1=I(J4)
505 J5=L3+J3-1
I(J5)=IN1+I(J5)
IF(M2)507,507,506
CC*** 506 J4=L2+J3-1
506 J4=L2+ICT
IN2=I(J4)
507 J5=L3+J3
I(J5)=IN2+I(J5)
510 CONTINUE
RETURN
C ADD 3 BOX
107 IF(M1)750,750,751
750 IN1=I(L1)
751 IF(M2)752,752,753
752 IN2=I(L2)
753 IF(M3)754,754,755
754 IN3=I(L3)
755 DO 780J3=1,NSAM
IF(M1)757,757,756
756 J4=L1+J3-1
IN1=I(J4)
757 IF(M2)759,759,758
758 J5=L2+J3-1
IN2=I(J5)
759 IF(M3)761,761,760
760 J6=L3+J3-1
IN3=I(J6)
761 J7=L4+J3-1
I(J7)=IN1+IN2+IN3
780 CONTINUE
RETURN
C ADD 4 BOX
108 IF(M1)850,850,851
850 IN1=I(L1)
851 IF(M2)852,852,853
852 IN2=I(L2)
853 IF(M3)854,854,855
854 IN3=I(L3)
855 IF(M4)856,856,857
856 IN4=I(L4)
857 DO 880J3=1,NSAM
IF(M1)859,859,858
858 J4=L1+J3-1
IN1=I(J4)
859 IF(M2)861,861,860
860 J5=L2+J3-1
IN2=I(J5)
861 IF(M3)863,863,862
862 J6=L3+J3-1
IN3=I(J6)
863 IF(M4)865,865,864
864 J7=L4+J3-1
IN4=I(J7)
865 J8=L5+J3-1
I(J8)=IN1+IN2+IN3+IN4
880 CONTINUE
RETURN
C MULTIPLIER
109 IF(M1)900,900,901
900 XIN1=FLOAT(I(L1))*SFI
901 IF(M2)902,902,903
902 XIN2=FLOAT(I(L2))*SFI
903 DO 908J3=1,NSAM
IF(M1)905,905,904
904 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
905 IF(M2)907,907,906
906 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
907 J6=L3+J3-1
I(J6)=XIN1*XIN2*SFID
908 CONTINUE
RETURN
C SET NEW FUNCTION IN OSC OR ENV
110 ILOC=N1+6
IF(I(N1+1).EQ.105) ILOC=N1+4
IN1=I(3)+I(N1)-1
IIN1=I(IN1)/IP(12)
IF(IIN1)960,960,955
955 I(ILOC)=-IP(2)-(IIN1-1)*IP(6)
960 RETURN
C RANDOM AND HOLD GENERATOR
111 SUM=FLOAT(I(L4))*SFI
IF(M1)910,910,911
910 XIN1=FLOAT(I(L1))*SFI
911 IF(M2)912,912,913
912 XIN2=FLOAT(I(L2))*SFI
913 IRN=I(L5)
DO 940J3=1,NSAM
IF(M1)916,916,915
915 J4=L1+J3-1
XIN1=FLOAT(I(J4))*SFI
916 IF(M2)918,918,917
917 J5=L2+J3-1
XIN2=FLOAT(I(J5))*SFI
918 IF(SUM-XNFUN)920,919,919
919 SUM=SUM-XNFUN
I(7)=IABS (I(7)*IMULT)
RN=(2.*FLOAT(I(7))*SFF-1.)
920 J7=L3+J3-1
I(J7)=XIN1*RN*SFID
SUM=SUM+XIN2
940 CONTINUE
I(L4)=IFIX(SUM*SFID)
I(L5)=IRN
RETURN
END
CGEN1 FUNCTION GENERATOR 1
C *** MUSIC V ***
SUBROUTINEGEN1
DIMENSIONI(15000),P(100),IP(20)
COMMONI,P/PARM/IP
N1=IP(2)+(IFIX(P(4))-1)*IP(6)
M1=7
SCLFT=IP(15)
102 IF(P(M1+1))103,103,100
100 V1=P(M1-2)*SCLFT
V2=(P(M1)-P(M1-2))/(P(M1+1)-P(M1-1))*SCLFT
MA=N1+IFIX(P(M1-1))
MB=N1+IFIX(P(M1+1))-1
DO 101J=MA,MB
XJ=J-MA
101 I(J)=V1+V2*XJ
IF(IFIX(P(M1+1)).EQ.(IP(6)-1))GO TO 103
M1=M1+2
GO TO 102
103 I(MB+1)=P(M1)*SCLFT
RETURN
END
CGEN2 FUNCTION GENERATOR 2
C *** MUSIC V ***
SUBROUTINEGEN2
DIMENSIONI(15000),P(100),IP(20),A(7000)
COMMONI,P/PARM/IP
EQUIVALENCE(I,A)
SCLFT=IP(15)
N1=IP(2)+(IFIX(P(4))-1)*IP(6)
N2=N1+IP(6)-1
DO 101K1=N1,N2
101 A(K1)=0.0
FAC=6.283185/(FLOAT(IP(6))-1.0)
NMAX=I(1)
N3=5+INT(ABS(P(NMAX)))-1
IF(N3-5)104,100,100
100 DO 103J=5,N3
FACK=FAC*FLOAT(J-4)
DO 102K=N1,N2
102 A(K)=A(K)+SIN(FACK*FLOAT(K-N1))*P(J)
103 CONTINUE
104 N4=N3+1
N5=I(1)-1
IF(N5-N4)114,105,105
105 DO 107J1=N4,N5
FACK=FAC*FLOAT(J1-N4)
DO 106K1=N1,N2
106 A(K1)=A(K1)+COS(FACK*FLOAT(K1-N1))*P(J1)
107 CONTINUE
114 CONTINUE
IF(P(NMAX))112,112,108
108 FMAX=0.0
DO 110K2=N1,N2
IF(ABS(A(K2))-FMAX)110,110,109
109 FMAX=ABS(A(K2))
110 CONTINUE
113 DO 111K3=N1,N2
111 I(K3)=(A(K3)*SCLFT*.99999)/FMAX
RETURN
112 FMAX=.99999
GO TO 113
END
CGEN3 FUNCTION GENERATOR 3
C *** MUSIC V ***
C ASSUMPTIONS--P(4) = THE NUMBER OF THE FUNCTION TO BE GENERATED,
C I(1) = WORD COUNT FOR CURRENT DATA RECORD
C P(5) = THE BEGINNING THE THE LIST OF DESCRIPTION NUMBERS
C IP(2) = THE BEGINNING SUBSCRIPT FOR FUNCTIONS IN THE I ARRAY,
C IP(6) = THE LENGTH OF THE FUNCTIONS
C IP(15) = SCALE FACTOR FOR STORED FUNCTIONS
C
SUBROUTINE GEN3
COMMON I(15000),P(100) /PARM/ IP(20)
N=I(1)-5
NL=5
SCLFT=IP(15)
LL=IP(6)
RMIN=0
RMAX=0
NR=NL+N
DO 10 J=NL,NR
IF(P(J).GT.RMAX) RMAX=P(J)
10 IF(P(J).LT.RMIN) RMIN=P(J)
DIV=AMAX1(ABS(RMIN),ABS(RMAX))
N1 = IP(2) + (IFIX(P(4))-1)*IP(6)
I(N1)=(P(NL)/DIV)*SCLFT
LAST = N1
DO 100 J=1,N
LL = LL-LL/(N-J+1)
IX = N1+IP(6)-LL-1
IX2 = NL+J
I(IX)=(P(IX2)/DIV)*SCLFT
DELTA=FLOAT(I(IX))-FLOAT(I(LAST))
NR = IX-LAST-1
SEG = NR+1
HNCR=DELTA/SEG
DO 50 K=1,NR
IX2 = LAST+K
50 I(IX2)=FLOAT(I(IX2-1))+HNCR
100 LAST=IX
RETURN
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
C *** MUSIC V ***
SUBROUTINE DATA (N)
COMMON I(15000),P(100)
READ (N) K,(P(J),J=1,K)
I(1)=K
RETURN
END
CPARM CONTROL DATA SPECIFICATION FOR PASS 3
C *** MUSIC V ***
C
C IP(1) = NUMBER OF OP CODES
C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION
C IP(3) = STANDARD SAMPLING RATE
C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS
C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS
C IP(6) = LENGTH OF FUNCTIONS
C IP(7) = BEGINNING OF NOTE CARD PARAMETERS
C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS
C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS
C IP(10)= BEGINNING OF OUTPUT DATA BLOCK
C IP(11)= SOUND ZERO (SILENCE VALUE)
C IP(12)= SCALE FACTOR FOR NOTE CARD PARAMETERS
C IP(13)= BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(14)= LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(15)= SCALE FACTOR FOR FUNCTIONS
C
BLOCK DATA
COMMON /PARM/IP(20)
DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
1 "1000000,6657,512,"377777777777,5*0/
C*****BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/
END
CC****SUBROUTINE DUM
CC****ENTRY SAMGEN
CC****ENTRY GEN4
CC****ENTRY GEN5
CC****END
SUBROUTINE SAMGEN
RETURN
END
SUBROUTINE GEN4
END
SUBROUTINE GEN5
END
C **** DUMMY SUBROUTINES ****
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
INTEGER PEAK
COMMON I(15000),P(100)/PARM/IP(20)/FINOUT/PEAK,NRSOR
K=IP(10)
L=IP(10)+IP(14)-1
DO 1 J=K,L
1 I(J)=0
CALL SAMOUT(IDSK,IP(14))
CC REWIND NWRITE
CC WRITE (6,10) PEAK,NRSOR
TYPE 10,PEAK,NRSOR
CC*** CALL EXIT
IF(IDSK.LT.0)CALL EXIT
J=IP(10)
L=J+1024
DO 2 K=J,L
2 I(K)=0
C WILL WRITE 1024 0'S ON DSK.
CALL FASTOUT(I(J),1024)
CALL FINFILE
CALL EXIT
10 FORMAT ('0PEAK AMPLITUDE WAS',I8/'0NUMBER OF SAMPLES OUT OF RANGE
1WAS',I8)
END
CDSMOUT DEBUG SAMOUT
C *** MUSIC V ***
C DEBUG SAMOUT
SUBROUTINE SAMOUT(IDSK,N)
DIMENSION IDBUF(2000),MS(3)
C*** IDSK IS FLAG TO WRITE SAMPLES ON DSK -- PDP *****
C*** IDBUF WILL STORE PACKED SAMPLES. ****
DIMENSIONI(15000),T(10),P(100),IP(20)
COMMON I,P/PARM/IP/FINOUT/PEAK,NRSOR
INTEGER PEAK
IF(IDSK.GE.0)GO TO 99
N1=N
PRINT100,N1
100 FORMAT(7H OUTPUTI6,8H SAMPLES)
N2=IP(10)-1
N3=10
GO TO 104
106 DO 101L=1,10
J=N2+L
101 T(L)=FLOAT(I(J))/FLOAT(IP(12))
PRINT102,(T(K),K=1,N3)
102 FORMAT(1H 10F11.4)
N2=N2+10
N1=N1-10
IF(N1)103,103,104
103 RETURN
104 IF(N1-10)105,106,106
105 N3=N1
GO TO 106
99 J=IDSK+1
M1=IP(10)
M2=0
ISC=IP(12)
IDSK=IDSK+N
C COUNTS SAMPLES TO DATE
DO 1 K=J,IDSK
N1=I(M1+M2)/ISC
IF(N1.GT.PEAK)PEAK=N1
IDBUF(K)=N1
1 M2=M2+1
IF(IDSK.LT.768)RETURN
KL=0
DO 2 K=1,768,3
KL=KL+1
KJ=K-1
MS(1)=IDBUF(K)
IF(MS(1).EQ.2048)MS(1)=2047
C A 2048 IN THE 12 LEFT HAND BITS CREATES PROBLEMS
DO 3 L=2,3
MS(L)=IDBUF(KJ+L)
3 IF(MS(L).LT.0)MS(L)=4096+MS(L)
2 IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
C MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
C NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
CALL FASTOUT(IDBUF(1),256)
J=IDSK-768
IF(J.LT.1)GO TO 4
DO 5 K=1,J
5 IDBUF(K)=IDBUF(768+K)
4 IDSK=J
RETURN
END
CERRO1 GENERAL ERROR ROUTINE
C *** MUSIC V ***
SUBROUTINEERROR(I)
PRINT100,I
100 FORMAT (' ERROR OF TYPE',I5)
RETURN
END